perm filename QUICK.PAS[1,ALS] blob sn#387805 filedate 1978-10-16 generic text, type T, neo UTF8
PROGRAM QUICKSORT(OUTPUT);

(**********************************************************************)

CONST

MAXSORT=	8000;
MAXINDX=	8001;
MAXSTACK=	200;
M=		9;
INFINITY=	2147483647;


TYPE

SORTINDX=	0 .. MAXINDX;
SORTITEM=	INTEGER;
SORTARY=	ARRAY [SORTINDX] OF SORTITEM;

VAR

A:		SORTARY;

(**********************************************************************)
PROCEDURE WRTINT(I,LEN: INTEGER);

VAR
POW10:	INTEGER;
NEG:	BOOLEAN;
DIGS:	INTEGER;
TMP:	INTEGER;

BEGIN

  NEG:=FALSE;
  IF I<0 THEN BEGIN
    LEN:=LEN-1;
    NEG:=TRUE;
    I:=-I;
  END;

  DIGS:=0;
  TMP:=I;
  POW10:=1;
  REPEAT
    TMP:=TMP DIV 10;
    POW10:=POW10*10;
    DIGS:=DIGS+1;
  UNTIL TMP=0;

  FOR TMP:=LEN DOWNTO DIGS DO BEGIN
    WRITE(' ');
  END;

  IF NEG THEN BEGIN
    WRITE('-');
  END;
  
  REPEAT
    POW10:=POW10 DIV 10;
    TMP:=I DIV POW10;
    WRITE(CHR(TMP+ORD('0')));
    I:=I MOD POW10;
  UNTIL POW10=1;

END;
(**********************************************************************)

PROCEDURE INITARY(VAR ARY: SORTARY);

CONST
A=	54321;
C=	0;
M=	59999;

VAR
I:	SORTINDX;
RAND:	INTEGER;

BEGIN

RAND:=12345;
FOR I:=1 TO MAXINDX DO BEGIN
  RAND:=((A*RAND+C) MOD M);
  ARY[I]:=RAND;
END;
  
END;

(**********************************************************************)
PROCEDURE PRTARY(VAR A: SORTARY);

VAR
I:	SORTINDX;

BEGIN

FOR I:=1 TO MAXSORT DO BEGIN
  WRTINT(A[I],12);
  WRITELN(OUTPUT);
END;
WRITELN(OUTPUT);

END;
(**********************************************************************)

PROCEDURE SORT(VAR A: SORTARY);

LABEL	1,2,3,4,5,6;

VAR
P,
L,
R,
I,
J,
T:	INTEGER;
TMP,
V:	SORTITEM;
STACK:	ARRAY [0 .. MAXSTACK] OF INTEGER;

BEGIN

A[0]:=-INFINITY;
A[MAXSORT+1]:=INFINITY;

P:=0; L:=1; R:=MAXSORT;

1:
I:=L; J:=R+1; V:=A[L];
WHILE I<J DO BEGIN
  I:=I+1; WHILE A[I]<V DO I:=I+1;
  J:=J-1; WHILE A[J]>V DO J:=J-1;
  TMP:=A[J];
  A[J]:=A[I];
  A[I]:=TMP;
END;
TMP:=A[J];
A[J]:=A[L];
A[L]:=A[I];
A[I]:=TMP;
IF (R-J)>(J-L) THEN GOTO 3;
IF (J-L)<=M THEN GOTO 5;
IF (R-J)<=M THEN GOTO 4;
P:=P+2;
STACK[P]:=L;
STACK[P+1]:=J-1;

2:
L:=J+1;
GOTO 1;

3:
IF (R-J)<=M THEN GOTO 5;
IF (J-L)<=M THEN GOTO 2;
P:=P+2;
STACK[P]:=J+1;
STACK[P+1]:=R;

4:
R:=J-1;
GOTO 1;

5:
L:=STACK[P];
R:=STACK[P+1];
P:=P-2;
IF P>=0 THEN GOTO 1;

6:
FOR I:=2 TO MAXSORT DO BEGIN
  V:=A[I];
  J:=I-1;
  WHILE A[J]>V DO BEGIN
    A[J+1]:=A[J];
    J:=J-1;
  END;
  A[J+1]:=V;
END;

END;

(**********************************************************************)

BEGIN

INITARY(A);
(*PRTARY(A);*)
SORT(A);
PRTARY(A);
END.
(**********************************************************************)